home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Utilities / Miscellaneous / CopyPaste 3.3.4 / CopyPaste Tools Sourcecode / Uppercase / Uppercase.p < prev    next >
Encoding:
Text File  |  1997-06-06  |  1.8 KB  |  81 lines  |  [TEXT/CWIE]
  1. {•This sourcecode is an example for creating a FKey coderesource with•}
  2. {•Metrowerks Pascal. It is copyrighted by Peter Hoerster and released•}
  3. {•for free use in any Shareware or Freeware product as a way to thank all•}
  4. {•programmers who share code snippets. You may put this sources on any•}
  5. {•CD ROM or any Archive Server but you may not sell it. •}
  6.  
  7. {• For comments please write to <hoerster@muenster.de>•}
  8.  
  9.  
  10.  
  11.  
  12. unit Uppercase;
  13.  
  14. interface
  15.  
  16.     uses
  17.         Types, OSUtils, GestaltEqu, Script, notification, Resources, Events,
  18.          PascalA4, QuickDraw, ToolUtils, Memory, LowMem, Scrap;
  19.  
  20.  
  21.  
  22. {$MAIN}
  23.                         
  24.     procedure main;        
  25.  
  26. implementation
  27.  
  28. procedure dopaste;
  29.     const
  30.         pastecode=2422;
  31.     var 
  32.         qel: EvQelPtr;
  33.     begin
  34.             if ppostevent(3, pastecode, qel) = noerr then
  35.             qel^.evtqmodifiers := cmdkey;
  36.     end;
  37.  
  38.  
  39.  
  40.     procedure main;
  41.         const
  42.             step = 1000;
  43.         var
  44.             oldA4: LongInt;
  45.             myerr:oserr;
  46.             myclipsize,templongint, count, pos,rest,i,amount: longint;
  47.             myclipHandle: handle;
  48.     begin
  49.         oldA4 := SetCurrentA4;
  50.         myclipsize := GetScrap(nil, 'TEXT', templongint);
  51.         mycliphandle := Tempnewhandle(myclipsize,myerr);
  52.         if myerr=noerr then 
  53.             begin
  54.                 myclipsize := GetScraP(myclipHandle, 'TEXT', templongint);
  55.                 if myclipsize > 0 then
  56.                     begin
  57.                         pos:=0;
  58.                         count:=myclipsize div step;
  59.                         rest:=myclipsize mod step;
  60.                         Temphlock(mycliphandle,myerr);
  61.                         if myerr=noerr then 
  62.                             begin
  63.                                 for i := 1 to count do
  64.                                     begin
  65.                                         amount := step;
  66.                                         uppertext(Ptr(ord4(myclipHandle^)+pos), amount);
  67.                                         pos := i * step;
  68.                                     end;    
  69.                                 uppertext(Ptr(ord4(myclipHandle^)+pos), rest);    
  70.                                 myerr := ZeroScrap;
  71.                                 myerr := putscrap(myclipsize, 'TEXT', myclipHandle^);
  72.                                 dopaste;
  73.                             end;
  74.                         Temphunlock(myCliphandle,myerr);
  75.                     end;
  76.             end;
  77.         TempDisposeHandle(myCliphandle,myerr);
  78.         
  79.         oldA4 := SetA4(oldA4);
  80.     end;
  81. end.